home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpasextr.arc / PRINTDOC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-11-22  |  5.4 KB  |  238 lines
  1. program printdoc;
  2. {----------------------------------------------------------}
  3. {-                                                        -}
  4. {- This is a quick adhoc program to print out the         -}
  5. {- documentation for the video routines.                  -}
  6. {-                                                        -}
  7. {----------------------------------------------------------}
  8. Const
  9.    LineLength = 55;
  10.  
  11. Type
  12.    Str255 = String[255];
  13.    Str2   = String[2];
  14.    Str70  = String[70];
  15.    TCSet  = Set of 0..255;
  16.  
  17. Var
  18.    Lines  : Array[1..66]  Of Str70;
  19.    Head   : Array[1..5]   Of Str70;
  20.    Foot   : Array[48..66] Of Str70;
  21.    FilVar : Text;
  22.  
  23.    Done,
  24.    PgSet  : Boolean;
  25.  
  26.    i,
  27.    PageNo : Integer;
  28.    TC     : Str2;
  29.  
  30. Procedure WriteSt(St : Str255);          External 'V24.ENH';
  31. Procedure WaitMsg(    X,Y   : Integer;
  32.                       St    : Str255;
  33.                       TESet : TCSet;
  34.                   Var TC    : Str2);     External 'V21.ENH';
  35.  
  36. Procedure SetPageNo(Var Line : Str70);
  37. Var
  38.    St   : String[70];
  39.    Code : Integer;
  40. Begin
  41.    Move(Line[7],St[1],2);
  42.    St[0] := Chr(2);
  43.    Val(St,PageNo,Code);
  44.    FillChar(Line[1],70,32);
  45.    Line[0] := Chr(0);
  46. End;
  47.  
  48. Procedure SetHead(Var Line : Str70);
  49. Var
  50.    St     : Str70;
  51.    LineNo,
  52.    Code   : Integer;
  53. Begin
  54.    Move(Line[7],St[1],2);
  55.    St[0] := Chr(2);
  56.    Val(St,LineNo,Code);
  57.    FillChar(Head[LineNo][1],70,32);
  58.    Head[LineNo] := '';
  59.    Head[LineNo] := Line;
  60.    FillChar(Line[i],70,32);
  61.    Line := '';
  62.    Delete(Head[LineNo],1,8);
  63. End;
  64.  
  65. Procedure SetFoot(Var Line : Str70);
  66. Var
  67.    St     : Str70;
  68.    LineNo,
  69.    Code   : Integer;
  70. Begin
  71.    Move(Line[7],St[1],2);
  72.    St[0] := Chr(2);
  73.    Val(St,LineNo,Code);
  74.    FillChar(Foot[LineNo][1],70,32);
  75.    Foot[LineNo] := '';
  76.    Foot[LineNo] := Line;
  77.    FillChar(Line[i],70,32);
  78.    Line := '';
  79.    Delete(Foot[LineNo],1,8);
  80. End;
  81.  
  82. Procedure ReadPage;
  83. Var
  84.    i  : Integer;
  85.    pn : String[2];
  86.    St     : String[70];
  87. Begin
  88.    For i := 1 to 66 Do Begin
  89.       FillChar(Lines[i][1],70,32);
  90.       Lines[i][0] := Chr(0);
  91.    End;
  92.    PageNo := PageNo + 1;
  93.    i := 6;
  94.    While (i <= 47) And (Not Done) Do Begin
  95.       If Eof(FilVar) Then
  96.          Done := True
  97.       Else Begin
  98.          Readln(FilVar,Lines[i]);
  99.          Move(Lines[i][1],St[1],6);
  100.          St[0] := Chr(6);
  101.          If St = '..pgno' Then
  102.             SetPageNo(Lines[i])
  103.          Else If St = '..head' Then
  104.             SetHead(Lines[i])
  105.          Else If St = '..foot' Then
  106.             SetFoot(Lines[i])
  107.          Else If St = '..page' Then Begin
  108.                FillChar(Lines[i][1],70,32);
  109.                Lines[i] := '';
  110.                i := 48;
  111.             End
  112.          Else
  113.             i := i + 1;
  114.       End
  115.    End;
  116. End;
  117.  
  118. Procedure RightJustify(Var St : Str70);
  119. Begin
  120.    Move(St[1],St[LineLength+1-Length(St)],Length(St));
  121.    FillChar(St[1],LineLength-Length(St),32);
  122.    St[0] := Chr(LineLength);
  123. End;
  124.  
  125. Procedure Center(Var St : Str70);
  126. Var
  127.    i : Integer;
  128. Begin
  129.    i := (LineLength Div 2) - (Length(St) Div 2) + 1;
  130.    Move(St[1],St[i],Length(St));
  131.    FillChar(St[1],i-1,32);
  132.    St[0] := Chr(i+Length(St)-1);
  133. End;
  134.  
  135. Procedure AdjustHeaders;
  136. Var
  137.    St,St1: Str70;
  138.    i,j,k : Integer;
  139. Begin
  140.    For i := 1 To 5 Do
  141.       If Head[i] = '' Then
  142.          Lines[i] := ''
  143.       Else Begin
  144.          St  := Head[i][1];
  145.          St1 := Head[i];
  146.          Delete(St1,1,1);
  147.          If UpCase(St[1]) = 'R' Then
  148.             RightJustify(St1)
  149.          Else If UpCase(St[1]) = 'C' Then
  150.             Center(St1)
  151.          Else If UpCase(St[1]) = 'A' Then
  152.             If Odd(PageNo) Then
  153.                RightJustify(St1);
  154.          Lines[i] := St1;
  155.       End;
  156. End;
  157.  
  158. Procedure AdjustFooters;
  159. Var
  160.    St,St1: Str70;
  161.    i,j,k : Integer;
  162. Begin
  163.    For i := 48 To 66 Do
  164.       If Foot[i] = '' Then
  165.          Lines[i] := ''
  166.       Else Begin
  167.          St  := Foot[i][1];
  168.          St1 := Foot[i];
  169.          Delete(St1,1,1);
  170.          If UpCase(St[1]) = 'R' Then
  171.             RightJustify(St1)
  172.          Else If UpCase(St[1]) = 'C' Then
  173.             Center(St1)
  174.          Else If UpCase(St[1]) = 'A' Then
  175.             If Odd(PageNo) Then
  176.                RightJustify(St1);
  177.          Lines[i] := St1;
  178.       End;
  179. End;
  180.  
  181. Procedure DoPageNumber;
  182. Var
  183.    i,j,c : Integer;
  184.    St    : Str70;
  185.    pgno  : String[2];
  186. Begin
  187.    For i := 1 To 66 Do Begin
  188.       j := Pos('##',Lines[i]);
  189.       FillChar(St[0],3,0);
  190.       If j > 0 Then Begin
  191.          Str(PageNo:1,St);
  192.          Move(St[1],Lines[i][j],Length(St));
  193.          If Length(St) = 1 Then Begin
  194.             Delete(Lines[i],j+1,1);
  195.             Insert(' ',Lines[i],1);
  196.          End;
  197.       End;
  198.    End;
  199. End;
  200.  
  201. Procedure PrintPage;
  202. Var
  203.    i  : Integer;
  204.    ch : Char;
  205. Begin
  206.    AdjustHeaders;
  207.    AdjustFooters;
  208.    DoPageNumber;
  209.    For i := 1 to 66 do
  210.       Writeln(lst,'          ',Lines[i]);
  211. End;
  212.  
  213. Begin
  214.    PageNo := 0;
  215.    For i := 1 to 5 Do Begin
  216.       FillChar(Head[i][1],70,32);
  217.       Head[i][0] := Chr(0);
  218.    End;
  219.    For i := 48 to 66 Do Begin
  220.       FillChar(Foot[i][1],70,32);
  221.       Foot[i][0] := Chr(0);
  222.    End;
  223.    ClrScr;
  224.    Gotoxy(10,10);
  225.    WriteSt('Make sure your printer is on and ready to print');
  226.    Gotoxy(10,36);
  227.    WaitMsg(10,11,'Press [ENTER] when ready',[13],TC);
  228.    Assign(FilVar,'VIDEO.DOC');
  229.    Reset(FilVar);
  230.    Done := False;
  231.    While Not Done Do Begin
  232.       ReadPage;
  233.       PrintPage;
  234.    End;
  235.    Close(FilVar);
  236. End.
  237.  
  238.